home *** CD-ROM | disk | FTP | other *** search
/ MacWorld 1998 January / Macworld (1998-01).dmg / Shareware World / Comms & Internet / HTML mode 2.0 etc. / frontierMenu.tcl < prev    next >
Text File  |  1997-09-22  |  22KB  |  781 lines
  1. ## -*-Tcl-*-
  2.  # ###################################################################
  3.  #  Frontier menu - tools for using Alpha as Frontier's external editor
  4.  # 
  5.  #  FILE: "frontierMenu.tcl"
  6.  #                                    created: 97-04-03 22.01.22 
  7.  #                                last update: 97-09-06 18.02.43 
  8.  #  Author: Johan Linde
  9.  #  E-mail: <jl@theophys.kth.se>
  10.  #     www: <http://bach.theophys.kth.se/~jl/Alpha.html>
  11.  #  
  12.  # Version: 2.0
  13.  # 
  14.  # Copyright 1997 by Johan Linde
  15.  #  
  16.  # Much of the tcl code and the Frontier scripts have been written by 
  17.  # Danis Georgiadis <dmg@hyper.gr>
  18.  # 
  19.  # This software may be used freely, and distributed freely, as long as the 
  20.  # receiver is not obligated in any way by receiving it.
  21.  #  
  22.  # If you make improvements to this file, please share them!
  23.  # 
  24.  # ###################################################################
  25.  ##
  26.  
  27.  
  28. if $startingUp {
  29.     # Use the Frontier menu icon for Alpha 6.51 and above, otherwise call the menu "Frontier".
  30.     regexp {([0-9]+\.[0-9]+)[ab]?([0-9]*)} [version] dummy __vers __beta
  31.     if {$__vers < 6.51 || $__vers == 6.51 && $__beta != ""} {
  32.         set frontierMenu Frontier
  33.     } else {
  34.         set frontierMenu "•142"
  35.     }
  36.     addMenu frontierMenu
  37.     catch {unset __vers __beta}
  38.     set frontierScriptMenu Scripts
  39. #     set frontierScriptMenu •144
  40.     return
  41. }
  42.  
  43. proc frontierMenu {} {}
  44.  
  45. # ◊◊◊◊ Change below for new system §14 ◊◊◊◊ #
  46.  
  47. # Preferences
  48. newModeVar Fron autoLaunch 0 1
  49. newModeVar Fron BrowsePoints {{root root} {Websites user.websites}} 0
  50. newModeVar Fron OpenPoints {{Websites user.websites} {Glossary user.html.glossary} {Templates user.html.templates}} 0
  51.  
  52. # ◊◊◊◊ end changing for new system §14 ◊◊◊◊ #
  53.  
  54. proc frontierBrowseMenu {} {
  55.     global FronmodeVars
  56.     set bl {}
  57.     foreach b $FronmodeVars(BrowsePoints) {
  58.         lappend bl [lindex $b 0]
  59.     }
  60.     return [list menu -n Browse -p frontierMenuProc -m [concat $bl [list "(-" "Browse at…" Add… Remove…]]]
  61. }
  62.  
  63. proc frontierOpenMenu {} {
  64.     global FronmodeVars
  65.     set bl {}
  66.     foreach b $FronmodeVars(OpenPoints) {
  67.         lappend bl [lindex $b 0]
  68.     }
  69.     return [list menu -n Open -p frontierMenuProc -m [concat $bl [list "(-" "Open…" Add… Remove…]]]
  70. }
  71.  
  72. # Menu definition
  73. menu -n $frontierMenu -p frontierMenuProc -m [list \
  74.     "<U<O/FSwitch to Frontier" \
  75.     "<U<O/'View in Browser" \
  76.     "<I<O/YFrontier Shell" \
  77.     [frontierBrowseMenu] \
  78.     [frontierOpenMenu] \
  79.     "Rebuild Scripts Menu" \
  80.     Preferences…]
  81.  
  82. proc frontierMenuProc {menu item} {
  83.     global frontierMenu FronmodeVars
  84.     switch -glob $menu {
  85.         •* {
  86.             switch $item {
  87.                 "Switch to Frontier" {launchForeAppl 'LAND'}
  88.                 Preferences {FronmodifyFlags}
  89.                 default {eval frontier[join $item ""]}
  90.             }
  91.         }
  92.         Browse {
  93.             switch $item {
  94.                 "Browse at" {frontierBrowseAt}
  95.                 Add {frontierAddPoint Browse}
  96.                 Remove {frontierRemovePoint Browse}
  97.                 default {
  98.                     foreach b $FronmodeVars(BrowsePoints) {
  99.                         if {[lindex $b 0] == $item} {
  100.                             odbBrowse [lindex $b 1]
  101.                             break
  102.                         }
  103.                     }
  104.                 }
  105.             }
  106.         }
  107.         Open {
  108.             switch $item {
  109.                 Open {frontierOpen}
  110.                 Add {frontierAddPoint Open}
  111.                 Remove {frontierRemovePoint Open}
  112.                 default {
  113.                     foreach b $FronmodeVars(OpenPoints) {
  114.                         if {[lindex $b 0] == $item} {
  115.                             frontierDoScript "edit (@[lindex $b 1])" front
  116.                             break
  117.                         }
  118.                     }
  119.                 }
  120.             }
  121.         }
  122.     }
  123. }
  124.  
  125.  
  126. # Called by Frontier when opening a Frontier text document in Alpha.
  127. proc openFromFrontier {} {
  128.     global frontierWinList winModes
  129.     set name [lindex [winNames -f] 0]
  130.     set name0 [stripNameCount $name]
  131.     if {[lsearch -exact $frontierWinList $name0] < 0} {lappend frontierWinList $name0}
  132. }
  133.  
  134. # If the current document is a Frontier document, it is updated in Frontier.
  135. proc frontierSavePostHook {name} {
  136.     global frontierWinList
  137.     if {[lsearch -exact $frontierWinList $name] >= 0} {
  138.         launchBackAppl 'LAND'
  139.         AEBuild 'LAND' ALFA FMod "----" "“${name}”"
  140.     }
  141. }
  142.  
  143. # ◊◊◊◊ Change below for new system §15 ◊◊◊◊ #
  144.  
  145. # Adds the above proc to the list of procs to be called after a document is saved.
  146. if {![info exists savePostHooks] || [lsearch -exact $savePostHooks frontierSavePostHook] < 0} {
  147.     lappend savePostHooks frontierSavePostHook
  148. }
  149.  
  150. # ◊◊◊◊ end changing for new system §15 ◊◊◊◊ #
  151.  
  152. # A list of windows opened from Frontier.
  153. if {![info exists frontierWinList]} {set frontierWinList {}}
  154.  
  155. # Executes a script in Frontier.
  156. proc frontierDoScript {script {front 0} {alert 1}} {
  157.     launchBackAppl 'LAND'
  158.     if {[catch {dosc -c 'LAND' -s $script} returnvalue]} {
  159.         if {$alert} {
  160.             alertnote "Frontier $returnvalue"
  161.             error "Frontier $returnvalue"
  162.         }
  163.         error $returnvalue
  164.     } elseif {$front == "front"} {
  165.         switchTo 'LAND'
  166.     }
  167.     return $returnvalue
  168. }
  169.  
  170. # Executes one of the scripts in Frontier, which are required to use Alpha with Frontier.
  171. proc frontierDoAlphaScript {script} {
  172.     global HOME
  173.     if {[catch {frontierDoScript $script 0 0} res]} {
  174.         alertnote "The Frontier verbs required to integrate Alpha and Frontier have not been\
  175.             properly installed. See the file 'Frontier Help.'"
  176.         edit -r -c "$HOME:Help:Frontier Help"
  177.         error $res
  178.     }
  179.     return $res
  180. }
  181.  
  182. # ◊◊◊◊ Change below for new system §16 ◊◊◊◊ #
  183.  
  184. # Redefines closeHook
  185. if {[info commands frontierCloseHook] == ""} {
  186.     rename closeHook frontierCloseHook
  187.     # If the window to be closed is a Frontier document, it is removed
  188.     # from Frontier's list of open external documents.
  189.     proc closeHook {name} {
  190.         global frontierWinList frontierQSWin frontierCommandHistory frontierCommandNum
  191.         # First do the normal thing.
  192.         frontierCloseHook $name
  193.         # Then do the Frontier stuff.
  194.         if {[set where [lsearch -exact $frontierWinList $name]] >= 0} {
  195.             launchBackAppl 'LAND'
  196.             AEBuild 'LAND' ALFA FCls "----" "“${name}”"    
  197.             set frontierWinList [lreplace $frontierWinList $where $where]
  198.         }
  199.         if {$name == $frontierQSWin} {set frontierCommandHistory ""; set frontierCommandNum 0}
  200.     }
  201. }
  202.  
  203. # Redefines saveasHook
  204. if {[info commands frontierSaveasHook] == ""} {
  205.     rename saveasHook frontierSaveasHook
  206.     proc saveasHook {oldname newname} {
  207.         global frontierWinList
  208.         # First do the normal thing.
  209.         frontierSaveasHook $oldname $newname
  210.         # Modify the Frontier win list if it's a Frontier window.
  211.         # and notify Frontier about it.
  212.         if {[set where [lsearch -exact $frontierWinList $oldname]] >= 0} {
  213.             set frontierWinList [lreplace $frontierWinList $where $where $newname]
  214.             launchBackAppl 'LAND'
  215.             AEBuild 'LAND' ALFA FMod "----" "“${oldname}”" zzzz "“${newname}”"
  216.         }
  217.     }
  218. }
  219.  
  220. # ◊◊◊◊ end changing for new system §16 ◊◊◊◊ #
  221.  
  222. # Does the same as 'View in Browser' in Frontier's web menu.
  223. proc frontierViewinBrowser {} {
  224.     global frontierWinList
  225.     if {![llength [winNames]]} {
  226.         alertnote "No window!"
  227.         return
  228.     }
  229.     if {[lsearch $frontierWinList [set name [stripNameCount [lindex [winNames -f] 0]]]] >= 0} {
  230.         if {[winDirty]} {
  231.             if {[set ask [askyesno -c "Save '[file tail $name]'?"]] == "yes"} {
  232.                 save
  233.             } elseif {$ask == "cancel"} {
  234.                 return
  235.             }
  236.         }
  237.         frontierDoAlphaScript "Alpha.viewInBrowser(\"$name\")"
  238.     } else {
  239.         alertnote "Not a Frontier window."
  240.     }
  241. }
  242.  
  243. # Open a window in Frontier
  244. proc frontierOpen {} {
  245.     if {![catch {frontierGetAddress} addr]} {
  246.         frontierDoScript "edit (@$addr)" front
  247.     }
  248. }
  249.  
  250. # Browse a table in Frontier
  251. proc frontierBrowseAt {} {
  252.     if {![catch {frontierGetAddress} addr]} {
  253.         odbBrowse $addr
  254.     }
  255. }
  256.  
  257. # Add to Browse and Open submenus
  258. proc frontierAddPoint {type} {
  259.     global FronmodeVars modifiedModeVars
  260.     set values ""
  261.     while {1} {
  262.         set values [dialog -w 450 -h 130 -t "Add $type menu item" 30 10 290 30 \
  263.             -t "Location in database:" 10 40 160 60 -e [lindex $values 0] 165 40 440 55 \
  264.             -t "Menu text:" 78 70 160 90 -e [lindex $values 1] 165 70 440 85 \
  265.             -b OK 20 100 85 120 -b Cancel 105 100 170 120]
  266.         if {[lindex $values 3]} {return}
  267.         set addr [string trim [lindex $values 0]]
  268.         if {$addr == ""} {alertnote "Location is database must be specified."; continue}
  269.         set text [string trim [lindex $values 1]]
  270.         if {$text == ""} {alertnote "The menu item must be specified."; continue}
  271.         if {[frontierDoScript "defined($addr)"] == "true"} {
  272.             set ex 0
  273.             foreach b $FronmodeVars(${type}Points) {
  274.                 if {[lindex $b 0] == $text} {alertnote "A menu item '$text' already exists."; set ex 1}
  275.             }
  276.             if {!$ex} {break}
  277.         } else {
  278.             alertnote "“$addr” is not a valid database address."
  279.         }
  280.     }
  281.     lappend FronmodeVars(${type}Points) [list $text $addr]
  282.     lappend modifiedModeVars [list ${type}Points FronmodeVars]
  283.     eval [eval frontier${type}Menu]
  284. }
  285.  
  286. # Remove from Browse and Open submenus.
  287. proc frontierRemovePoint {type} {
  288.     global FronmodeVars modifiedModeVars
  289.     set points {}
  290.     foreach b $FronmodeVars(${type}Points) {
  291.         lappend points [lindex $b 0]
  292.         set pointat([lindex $b 0]) [lindex $b 1]
  293.     }
  294.     if {![llength $points] || [catch {listpick -p "Select [string tolower $type] point to remove:" -l $points} points] ||
  295.         ![llength $points]} {return}
  296.     set points [lindex $points 0]
  297.     if {[askyesno "'$points' points to '$pointat($points)'. Remove?"] != "yes"} {return}
  298.     set n {}
  299.     foreach b $FronmodeVars(${type}Points) {
  300.         if {[lindex $b 0] != $points} {lappend n $b}
  301.     }
  302.     set FronmodeVars(${type}Points) $n
  303.     lappend modifiedModeVars [list ${type}Points FronmodeVars]
  304.     eval [eval frontier${type}Menu]
  305. }
  306.  
  307. proc frontierGetAddress {} {
  308.     while {1} {
  309.         if {[catch {set addr [prompt "Location in Frontier database:" ""]}]} {
  310.             error ""
  311.         } else {
  312.             set addr [string trimleft [string trim $addr] {@}]
  313.             switch [frontierDoScript "defined($addr)"] {
  314.                 "true"        {return $addr}
  315.                 "false"        {alertnote "“$addr” is not a valid database address"}
  316.                 ""            {error ""}
  317.             }
  318.         }
  319.     }
  320. }
  321.  
  322. proc FronmodifyFlags {} {
  323.     global FronmodeVars modifiedModeVars
  324.     set values [dialog -w 300 -h 110 -t "Frontier Preferences" 30 10 290 30 \
  325.         -c "Launch Frontier at startup" $FronmodeVars(autoLaunch) 10 40 290 60 \
  326.         -b OK 20 80 85 100 -b Cancel 105 80 170 100]
  327.     if {[lindex $values 2]} {return}
  328.     set i -1
  329.     foreach flag [list autoLaunch] {
  330.         global $flag
  331.         incr i
  332.         set val [lindex $values $i]
  333.         if {$FronmodeVars($flag) != $val} {
  334.             set $flag $val
  335.             set FronmodeVars($flag) $val
  336.             lappend modifiedModeVars [list $flag FronmodeVars]
  337.         }
  338.     }
  339. }
  340.  
  341. proc OdbmodifyFlags {} {
  342.     FronmodifyFlags
  343. }
  344.  
  345. #===============================================================================
  346. # Script menu
  347. # 
  348. # The code to extract a Frontier menu has been written by
  349. # Danis Georgiadis <dmg@hyper.gr>
  350. # 
  351. #===============================================================================
  352.  
  353. proc setFrontierMenuScript {menu item scpt} {
  354.     global frontierMenuScripts
  355.     if {[regexp {&$} $item]} {
  356.         set item [string trimright $item &]
  357.     } else {
  358.         regsub -all {<[BUISEO]} $item "" item
  359.         regsub {/[a-zA-Z]} $item "" item
  360.         regsub -all {[!\^].} $item "" item
  361.     }
  362.     set key [string trimright "$menu$item" …]
  363.     set frontierMenuScripts($key) $scpt
  364. }
  365.  
  366. proc frontierBuildScriptMenu {} {
  367.     global frontierScriptMenu FronmodeVars
  368.  
  369.     set running 0
  370.     foreach    p [processes] {
  371.         if {[lindex $p 1] == "LAND" } {
  372.             set running 1
  373.         }
  374.     }
  375.     if {!$running} {
  376.         if {$FronmodeVars(autoLaunch)} {
  377.             launchBackAppl 'LAND'
  378.         } else {
  379.             return
  380.         }
  381.     }
  382.     set sfina [frontierDoAlphaScript "Alpha.getMenuSource()"]
  383.      set ptext [frontierDoAlphaScript "Alpha.getDefsSource()"]
  384.     
  385.     set mtext [list menu -m -n $frontierScriptMenu -p frontierScriptMenuProc $sfina]
  386.     eval $mtext
  387.     eval $ptext
  388.     
  389.     insertMenu $frontierScriptMenu
  390.  
  391. }
  392.  
  393. proc frontierScriptMenuProc {menu item} {
  394.     global frontierMenuScripts frontierScriptMenu
  395.     if {$menu == $frontierScriptMenu} {set menu ""}
  396.     set key "$menu$item"
  397.     frontierDoScript $frontierMenuScripts($key)
  398. }
  399.  
  400. proc frontierRebuildScriptsMenu {} {
  401.     global frontierMenuScripts
  402.     launchBackAppl 'LAND'
  403.     frontierDoAlphaScript "Alpha.invalMenuSources()"
  404.     catch {unset frontierMenuScripts}
  405.     frontierBuildScriptMenu
  406. }
  407.  
  408.  
  409. #===============================================================================
  410. #
  411. # Frontier shell
  412. # 
  413. # Some ideas taken from Matlab mode by Stephen Merkowitz
  414. # 
  415. #===============================================================================
  416. set frontierQSWin "* Frontier shell *"
  417. set frontierCommandHistory ""
  418. set frontierCommandNum 0
  419.  
  420. proc frontierFrontierShell {} {
  421.     global frontierQSWin
  422.     
  423.     if {[lsearch [winNames] $frontierQSWin] >= 0} {
  424.         bringToFront $frontierQSWin
  425.     } else {
  426.         new -n $frontierQSWin
  427.         setWinInfo -w $frontierQSWin shell 1
  428.         
  429.         newMode Fron
  430.         insertText "Welcome to Alpha's Frontier shell\r«» "
  431.     }
  432. }
  433.  
  434.  
  435. proc frontierRunQuickScript {} {
  436.     global frontierCommandHistory frontierCommandNum frontierQSWin
  437.     set pos [getPos]
  438.  
  439.     set ind [string first "«» " [getText [lineStart $pos] [nextLineStart [getPos]]]]
  440.     if {$ind >= 0} {
  441.         set lStart [expr [lineStart $pos]+$ind+2]
  442.         endOfLine
  443.         set scriptName [getText $lStart [getPos]]
  444.         if {[getPos] != [maxPos]} {
  445.             goto [maxPos]
  446.             insertText $scriptName
  447.         }
  448.         
  449.         catch {frontierDoScript $scriptName 0 0} result
  450.         if {[string compare [lindex $frontierCommandHistory [expr [llength $frontierCommandHistory]-1]] $scriptName] != 0} {
  451.             lappend frontierCommandHistory $scriptName
  452.             if {[llength $frontierCommandHistory] > 30} {
  453.                 set frontierCommandHistory [lrange $frontierCommandHistory 1 end]
  454.             }
  455.         }
  456.         set frontierCommandNum [llength $frontierCommandHistory]
  457.         if {[string length $result]} {
  458.             insertText -w $frontierQSWin "\r" $result \r "«» "
  459.         } else {
  460.             insertText -w $frontierQSWin \r "«» "
  461.         }
  462.     } else {
  463.            if {[getPos] == [maxPos]} {
  464.             insertText "«» "
  465.         } else {
  466.             carriageReturn
  467.         }
  468.     }
  469.     return
  470. }
  471.  
  472.  
  473. proc frontierPrevCommand {} {
  474.     global frontierCommandHistory frontierCommandNum
  475.     
  476.     set text [getText [lineStart [getPos]] [nextLineStart [getPos]]]
  477.     if {[set ind [string first "«» " $text]] == 0} {
  478.         goto [expr [lineStart [getPos]] + $ind + 2]
  479.     } else return
  480.  
  481.     incr frontierCommandNum -1
  482.     if {$frontierCommandNum < 0} {
  483.         incr frontierCommandNum
  484.         endOfLine
  485.         return
  486.     }
  487.     set text [lindex $frontierCommandHistory $frontierCommandNum]
  488.     set to [nextLineStart [getPos]]
  489.     if {[lookAt [expr $to-1]] == "\r"} {incr to -1}
  490.     replaceText [getPos] $to $text
  491. }
  492.  
  493.  
  494. proc frontierNextCommand {} {
  495.     global frontierCommandHistory frontierCommandNum
  496.     
  497.     set text [getText [lineStart [getPos]] [nextLineStart [getPos]]]
  498.     if {[set ind [string first "«» " $text]] == 0} {
  499.         goto [expr [lineStart [getPos]] + $ind + 2]
  500.     } else return
  501.  
  502.     incr frontierCommandNum
  503.     if {$frontierCommandNum >= [llength $frontierCommandHistory]} {
  504.         incr frontierCommandNum -1
  505.         frontierCancelLine
  506.         return
  507.     }
  508.     set text [lindex $frontierCommandHistory $frontierCommandNum]
  509.     set to [nextLineStart [getPos]]
  510.     if {[lookAt [expr $to-1]] == "\r"} {incr to -1}
  511.     replaceText [getPos] $to $text
  512. }
  513.  
  514. proc frontierCancelLine {} {
  515.     global frontierCommandHistory frontierCommandNum
  516.  
  517.     set text [getText [lineStart [getPos]] [nextLineStart [getPos]]]
  518.     if {[set ind [string first "«» " $text]] == 0} {
  519.         goto [expr [lineStart [getPos]] + $ind + 3]
  520.     } else return
  521.     
  522.     set to [nextLineStart [getPos]]
  523.     deleteText [getPos] $to
  524.     
  525.     set frontierCommandNum [llength $frontierCommandHistory]
  526. }
  527.  
  528. proc frontierBol {} {
  529.     set text [getText [lineStart [getPos]] [nextLineStart [getPos]]]
  530.     if {[set ind [string first "«» " $text]] == 0} {
  531.         goto [expr [lineStart [getPos]] + $ind + 3]
  532.     } else {
  533.         goto [lineStart [getPos]]
  534.     }
  535. }
  536.  
  537.  
  538. regModeKeywords -m {«} Fron {}
  539. bind up <z> frontierPrevCommand Fron
  540. bind down <z> frontierNextCommand Fron
  541. bind '\r' frontierRunQuickScript Fron
  542. bind 'u'  <z>  frontierCancelLine  Fron
  543. bind left <c> frontierBol Fron
  544.  
  545. #===============================================================================
  546. # Odb browser
  547. # 
  548. # Written by Danis Georgiadis <dmg@hyper.gr> and modified by me to be integrated 
  549. # with the rest.
  550. # 
  551. #===============================================================================
  552.  
  553. set odbBrowserTabLength 3
  554. set odbBrowserTypeOffset 60
  555.  
  556. proc odbget120Spaces {} {
  557.     set spaces40 "                                        "
  558.     return "$spaces40$spaces40$spaces40"
  559. }
  560.  
  561. proc odbGetIndLevel {indStr} {
  562.     global odbBrowserTabLength
  563.     return [expr [string length $indStr] / $odbBrowserTabLength]
  564. }
  565.  
  566. proc odbGetIndString {indLevel} {
  567.     global odbBrowserTabLength
  568.     return [string range [odbget120Spaces] 0 [expr [expr $indLevel * $odbBrowserTabLength] - 1]]
  569. }
  570.  
  571. proc odbGetNextIndString {thisIndStr} {
  572.     return [odbGetIndString [expr [odbGetIndLevel $thisIndStr] + 1]]
  573. }
  574.  
  575. proc odbBrowseGetLineParts {name type addr level} {
  576.     global odbBrowserTypeOffset
  577.     global odbBrowserTabLength
  578.     
  579.     set indPadPart [odbGetIndString $level]
  580.     set namePart [string trim $name "\t "]
  581.     set typePadSize [expr $odbBrowserTypeOffset - [expr [string length $indPadPart] + [string length $name]]]
  582.     set typePadPart [string range [odbget120Spaces] 0 [expr $typePadSize - 1]]
  583.     set typePart "◊$type◊"
  584.     set addrPart "\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t∞$addr∞"
  585.     
  586.     set res ""
  587.     lappend res $indPadPart $namePart $typePadPart $typePart $addrPart
  588.     
  589.     return $res
  590. }
  591.  
  592. proc odbBrowseDown {} {
  593.     set curPos [getPos]
  594.     set curLineStart [lineStart $curPos]
  595.     set curLineEnd [nextLineStart $curPos]
  596.     select $curLineStart $curLineEnd
  597.     
  598.     set newLineStart [nextLineStart $curLineStart]
  599.     set newLineEnd [nextLineStart $newLineStart]
  600.     if {$newLineStart < [maxPos]} {
  601.         select $newLineStart $newLineEnd
  602.     }
  603. }
  604.  
  605. proc odbBrowseCmdDown {{option 0}} {
  606.     set curPos [getPos]
  607.     set curLineStart [lineStart $curPos]
  608.     set curLineEnd [nextLineStart $curPos]
  609.     
  610.     if {[regexp {^( *).+◊tabl◊\t+∞(.+)∞} [getText $curLineStart $curLineEnd] junk ind addr]} {
  611.         if {$option} {killWindow}
  612.         odbBrowse $addr
  613.     }
  614. }
  615.  
  616. proc odbBrowseUp {} {
  617.     set curPos [getPos]
  618.     set curLineStart [lineStart $curPos]
  619.     set curLineEnd [nextLineStart $curPos]
  620.     select $curLineStart $curLineEnd
  621.     
  622.     set newLineStart [prevLineStart $curLineStart]
  623.     set newLineEnd [nextLineStart $newLineStart]
  624.     if {$newLineEnd > 0} {
  625.         select $newLineStart $newLineEnd
  626.     }
  627. }
  628.  
  629. proc odbBrowseCmdUp {{option 0}} {
  630.     regexp {∞(.+)∞} [getText 0 [nextLineStart 0]] junk addr
  631.     if {[set point [string last "." $addr]] >= 0} {
  632.         if {$option} {killWindow}
  633.         odbBrowse [string range $addr 0 [expr $point - 1]]
  634.     }
  635. }
  636.  
  637. proc odbBrowserAddCells {pos cells indLevel} {
  638.     
  639.     set tmp ""
  640.     set colorCodes ""
  641.     set lastPos $pos
  642.     
  643.     foreach cell $cells {
  644.         set cellName [lindex $cell 0]
  645.         set cellType [lindex $cell 1]
  646.         set cellAddr [lindex $cell 2]
  647.         
  648.         set parts [odbBrowseGetLineParts $cellName $cellType $cellAddr $indLevel]
  649.         
  650.         set indPart [lindex $parts 0]
  651.         set namePart [lindex $parts 1]
  652.         set typePartPad [lindex $parts 2]
  653.         set typePart [lindex $parts 3]
  654.         set addrPart [lindex $parts 4]
  655.         
  656.         set nameStart [expr $lastPos + [string length $indPart]]
  657.         set nameEnd [expr $nameStart + [string length $namePart]]
  658.         
  659.         if {$cellType == "TEXT" || $cellType == "wptx"} {
  660.             lappend colorCodes [concat $nameStart 3]
  661.             lappend colorCodes [concat $nameEnd 0]
  662.         } elseif {$cellType == "tabl"} {
  663.             lappend colorCodes [concat $nameStart 5]
  664.             lappend colorCodes [concat $nameEnd 0]
  665.         } else {
  666.             lappend colorCodes [concat $nameStart 1]
  667.             lappend colorCodes [concat $nameEnd 0]
  668.         }
  669.         
  670.         set typeStart [expr $lastPos + [string length $indPart] + [string length $namePart] + [string length $typePartPad]]
  671.         set typeEnd [expr $typeStart + [string length $typePart]]
  672.         lappend colorCodes [concat $typeStart 4]
  673.         lappend colorCodes [concat $typeEnd 0]
  674.         
  675.         set line ""
  676.         append line $indPart $namePart $typePartPad $typePart $addrPart "\n"
  677.         append tmp $line
  678.         
  679.         set lastPos [expr $lastPos + [string length $line]]
  680.     }
  681.     
  682.     select $pos $pos
  683.     setWinInfo read-only 0
  684.     
  685.     insertText $tmp
  686.     
  687.     foreach colorCode $colorCodes {
  688.         insertColorEscape [lindex $colorCode 0] [lindex $colorCode 1]
  689.     }
  690.     
  691.     setWinInfo dirty 0
  692.     setWinInfo read-only 1
  693.     eval sizeWin [lrange [getGeometry] 2 end]
  694. }
  695.  
  696. proc odbBrowseRight {} {
  697.     set curPos [getPos]
  698.     set curLineStart [lineStart $curPos]
  699.     set curLineEnd [nextLineStart $curPos]
  700.     
  701.     if {[regexp {^( *).+◊tabl◊\t+∞(.+)∞} [getText $curLineStart $curLineEnd] junk ind addr]} {
  702.         set nextIndString [odbGetNextIndString $ind]
  703.         set nextLineText [getText [nextLineStart $curLineStart] [nextLineStart [nextLineStart $curLineStart]]]
  704.         if {![regexp "^$nextIndString" $nextLineText junk]} {
  705.             
  706.             set cells [frontierDoAlphaScript "Alpha.getCellData(@$addr)"]
  707.             odbBrowserAddCells $curLineEnd $cells [odbGetIndLevel $nextIndString]
  708.             
  709.         }
  710.     }
  711.     
  712.     select $curLineStart $curLineEnd
  713. }
  714.  
  715. proc odbBrowseLeft {} {
  716.     set curPos [getPos]
  717.     set curLineStart [lineStart $curPos]
  718.     set curLineEnd [nextLineStart $curPos]
  719.     
  720.     if {[regexp {^( *).+∞(.+)∞} [getText $curLineStart $curLineEnd] junk ind elems]} {
  721.         set pos [nextLineStart $curLineStart]
  722.         set start $pos
  723.         set nextIndString [odbGetNextIndString $ind]
  724.         while {[regexp "^$nextIndString" [getText $pos [nextLineStart $pos]] junk]} {
  725.             set pos [nextLineStart $pos]
  726.         }
  727.         setWinInfo read-only 0
  728.         deleteText $start $pos
  729.         setWinInfo dirty 0
  730.         setWinInfo read-only 1
  731.     }
  732.     select $curLineStart $curLineEnd
  733. }
  734.  
  735. proc odbBrowseEditObj {} {
  736.     set curPos [getPos]
  737.     set curLineStart [lineStart $curPos]
  738.     set curLineEnd [nextLineStart $curPos]
  739.     
  740.     if {[regexp {^.+∞(.+)∞} [getText $curLineStart $curLineEnd] junk addr]} {
  741.         frontierDoAlphaScript "Alpha.editCell(@$addr)"
  742.     }
  743. }
  744.  
  745. proc odbBrowse {{addr root}} {
  746.     if {$addr == ""} {
  747.         return
  748.     }
  749.     
  750.     global odbBrowserTypeOffset
  751.     global odbBrowserTabLength
  752.     
  753.     set cell [frontierDoAlphaScript "Alpha.getCellData(@$addr, false)"]
  754.     set wtitle "* Frontier “[lindex [lindex $cell 0] 2]” *"
  755.     
  756.     if {[lsearch [winNames] $wtitle] >= 0} {
  757.         bringToFront $wtitle
  758.     } else {
  759.         new -n $wtitle -g 4 42 449 300
  760.         setWinInfo dirty 0
  761.         newMode Odb
  762.         odbBrowserAddCells 0 $cell 0
  763.         select 0 [nextLineStart 0]
  764.         odbBrowseRight
  765.     }
  766. }
  767.  
  768. bind '\r'        odbBrowseEditObj    Odb
  769. bind enter        odbBrowseEditObj    Odb
  770.  
  771. bind down         odbBrowseDown        Odb
  772. bind down <c>    odbBrowseCmdDown    Odb
  773. bind down <co>    {odbBrowseCmdDown 1}    Odb
  774. bind up            odbBrowseUp            Odb
  775. bind up <c>        odbBrowseCmdUp        Odb
  776. bind up <co>    {odbBrowseCmdUp 1}        Odb
  777. bind right        odbBrowseRight        Odb
  778. bind left        odbBrowseLeft        Odb
  779.  
  780. catch {frontierBuildScriptMenu}
  781.